Lab 5 - Comunidades en las Redes

Carga de datos

Usemos de nuevo los datos de los innovadores en Seattle:

Como se ve, tenemos la matriz de adyacencia, la cual abriremos esta vez en R:

# limpiar memoria
rm(list = ls())

# abrir red
adjacency=read.csv(file.path('data','seattleTop_adjMx.csv'),row.names = 1) # la tabla tiene este nombre
matrix <- as.matrix(adjacency) 

# abrir atributos
attributes=read.csv(file.path('data','seattleTop_attrTbl.csv')) # la tabla tiene este nombre

En R, es común usar igraph para análisis básicos de redes. Creamos primero la red usando la matriz de adyacencia:

library(igraph)
topsNet <- graph_from_adjacency_matrix(matrix, mode="directed",weighted = TRUE) 
summary(topsNet)
## IGRAPH 5d3bae2 DNW- 46 588 -- 
## + attr: name (v/c), weight (e/n)

Como se ve, igraph nos informa que se ha creado la red asignándole un código (irrelevante), que es una red dirigida (DNW, la W indica que ha creado pesos en los enlaces), con 46 nodos y 588 enlaces. Indica que tiene un atributo name para los vértices (nodos) de tipo cáracter (texto), y que los enlaces (edges) tienen un atributo weight de tipo numérico.

Como tenemos una tabla con más atributos para los nodos, podemos añadirlos fácilmente:

V(topsNet)$male <- attributes$male
V(topsNet)$popularity <- attributes$followers

# ahora
summary(topsNet)
## IGRAPH 5d3bae2 DNW- 46 588 -- 
## + attr: name (v/c), male (v/n), popularity (v/n), weight (e/n)

Ya están los nuevos atributos para vértices, popularity y male, ambos de tipo numérico.

Exportemos esta red para que pueda ser leída por Gephi:

igraph::write_graph(topsNet,file.path('data',"topsNetFull.graphml"),
  format = "graphml")

Recordemos que nuestra red de Seattletonians:

  • No todos los nodos pueden llegar a otro nodo:
is_connected(topsNet,mode = c("strong"))
## [1] FALSE
  • Hay algunos grupos de nodos que sí pueden alcanzarse entre sí:
count_components(topsNet, mode = c("strong"))
## [1] 4
  • Estos son los que pueden alcanzarse entre sí:
g_comp=igraph::components(topsNet, mode = c("strong"))
g_comp
## $membership
##     rachelerman    mattmcilwain   DaveParkerSEA      toddbishop      ashannstew 
##               1               1               1               1               1 
##  LeslieFeinzaig         akipman       matt_oppy         gilbert    juliesandler 
##               1               1               1               1               1 
##         BradSmi        crashdev    ShaunaCausey    john_gabbert      moniguzman 
##               1               1               1               1               1 
##        mattmday     Rich_Barton           daryn    lovelletters         etzioni 
##               1               1               1               1               1 
##   MissDestructo   heatherredman      danshapiro        medinism    KieranSnyder 
##               1               1               1               1               1 
##           hadip RajSinghSeattle       funcOfJoe   kirbywinfield         stevesi 
##               1               1               1               1               1 
##     Ryanintheus      sonalpmane        SoGulley  X2morrowknight          jinman 
##               1               1               1               3               1 
##           tarah     Jenerationy         lanctot   Kristen_Hammy     nhuntwalker 
##               4               1               1               1               1 
##    eugenio_pace         JenMsft   PeterHamilton      sarahstood     mcolacurcio 
##               2               1               1               1               1 
## marybethlambert 
##               1 
## 
## $csize
## [1] 43  1  1  1
## 
## $no
## [1] 4

Guardemos la membresía a esos componentes como un atributo del nodo:

V(topsNet)$component=g_comp$membership

Vemos que uno de los componentes strongly connected es muy numeroso. Para efectos prácticos, quedémonos con ese:

# seleccionando
nodes_Subset=V(topsNet)[V(topsNet)$component==1]
# filtrando red
topsNet_giant=induced_subgraph(topsNet, nodes_Subset)

# ahora:
summary(topsNet_giant)
## IGRAPH 5b12f72 DNW- 43 575 -- 
## + attr: name (v/c), male (v/n), popularity (v/n), component (v/n),
## | weight (e/n)

Exportemos esta sub red para que pueda ser leída por Gephi:

igraph::write_graph(topsNet_giant,file.path('data',"topsNet_giant.graphml"),
  format = "graphml")

Veamos algunos valores importantes:

  • ¿Qué tan cerca está esta red strongly connected de ser una red complete?
edge_density(topsNet_giant)
## [1] 0.3183832
  • ¿Cuál es su diámetro y qué nodos son?
farthest_vertices(topsNet_giant)
## $vertices
## + 2/43 vertices, named, from 5b12f72:
## [1] akipman    sonalpmane
## 
## $distance
## [1] 4
  • ¿Qué tan recíproca es?
reciprocity(topsNet_giant)
## [1] 0.6782609
  • ¿Qué tanta homofilia hay en la red?

  • Hacia los más conectados:

assortativity_degree(topsNet_giant,directed = T)
## [1] -0.248864
  • Hacia los del mismo sexo:
assortativity(topsNet_giant, values=V(topsNet_giant)$male, directed = T)
## [1] 0.06411198
  • Hacia mismo nivel de popularidad:
assortativity(topsNet_giant, values=V(topsNet_giant)$popularity, directed = T)
## [1] -0.01605838


En busca de comunidades

Un paso inicial es saber qué tan alto es el coeficiente de clusterización:

  1. El promedio de cada nodo:
Figura 2. Coeficiente de Clusterización como promedio local.
Fuente: Antonio Y, Indratno SW, Saputro SW(2021) Pricing of cyber insurance premiums usinga Markov-based dynamic model with clusteringstructure.


transitivity(as.undirected(topsNet_giant,mode='collapse'),type = "localaverage")
## [1] 0.645001
  1. El promedio de la red:
Figura 3. Coeficiente de Clusterización global.
Fuente: Chalancon, G., Kruse, K., Babu, M.M. (2013). Clustering Coefficient.


transitivity(as.undirected(topsNet_giant,mode='collapse'),type = "global")
## [1] 0.5666072

Aquí igraph ha implementado el algoritmo sólo para el caso no dirigido. Por lo que probablemente este valor sea mayor al caso dirigido. Con un valor mayor a 0.5, podemos asumir que se puede encontrar clusters.



El Clique

Para darle más soporte a nuestra búsqueda de comunidades, hay que explorar la presencia de cliques.El clique es un conjunto de nodos donde todos pueden conectarse con todos. Para este caso, usarameos la librería statnet.

Como nuestra red la creamos con igraph, hay que convertirlo a grafo de statnet:

topsNet_giant_net <- intergraph::asNetwork(topsNet_giant)

# ya es de statnet:
topsNet_giant_net
##  Network attributes:
##   vertices = 43 
##   directed = TRUE 
##   hyper = FALSE 
##   loops = FALSE 
##   multiple = FALSE 
##   bipartite = FALSE 
##   total edges= 575 
##     missing edges= 0 
##     non-missing edges= 575 
## 
##  Vertex attribute names: 
##     component male popularity vertex.names 
## 
##  Edge attribute names: 
##     weight

Nuestro propósito aquí es saber si hay cliques:

library(statnet)
census <- clique.census(topsNet_giant_net)
# aqui vemos
census$clique.count
##   Agg rachelerman mattmcilwain DaveParkerSEA toddbishop ashannstew
## 1   0           0            0             0          0          0
## 2  10           0            2             0          0          0
## 3  17           2            0             2          2          0
## 4  13           4            2             1         12          0
## 5   9           2            0             0          8          1
## 6  12           6            0             3          8          1
## 7   6           4            0             1          6          2
## 8   2           2            0             2          2          0
## 9   1           1            0             1          1          0
##   LeslieFeinzaig akipman matt_oppy gilbert juliesandler BradSmi crashdev
## 1              0       0         0       0            0       0        0
## 2              0       1         0       0            0       2        1
## 3              0       0         1       2            1       1        2
## 4              0       0         0       1            4       2        0
## 5              3       0         0       0            2       0        2
## 6              4       0         3       0            9       0        2
## 7              4       0         1       0            4       0        1
## 8              1       0         1       0            2       0        0
## 9              1       0         0       0            1       0        0
##   ShaunaCausey john_gabbert moniguzman mattmday Rich_Barton daryn lovelletters
## 1            0            0          0        0           0     0            0
## 2            0            0          0        1           1     0            0
## 3            3            0          4        0           1     0            0
## 4            5            0          4        2           0     1            0
## 5            2            0          3        2           0     1            3
## 6            3            2          3        0           0     1            8
## 7            3            0          1        0           0     0            5
## 8            2            0          0        0           0     0            2
## 9            1            0          0        0           0     0            1
##   etzioni MissDestructo heatherredman danshapiro medinism KieranSnyder hadip
## 1       0             0             0          0        0            0     0
## 2       1             0             0          0        2            1     0
## 3       0             0             2          4        0            2     3
## 4       2             2             0          0        0            2     0
## 5       0             2             5          0        0            1     0
## 6       1             5             5          0        0            1     0
## 7       1             3             4          0        0            0     0
## 8       1             0             1          0        0            0     0
## 9       0             1             1          0        0            0     0
##   RajSinghSeattle funcOfJoe kirbywinfield stevesi Ryanintheus sonalpmane
## 1               0         0             0       0           0          0
## 2               2         1             1       1           0          0
## 3               2         0             2       5           2          0
## 4               0         0             0       0           1          0
## 5               0         0             1       3           1          0
## 6               0         0             2       2           1          2
## 7               0         0             0       1           0          0
## 8               0         0             0       0           0          0
## 9               0         0             0       0           0          0
##   SoGulley jinman Jenerationy lanctot Kristen_Hammy nhuntwalker JenMsft
## 1        0      0           0       0             0           0       0
## 2        0      0           0       1             0           1       1
## 3        1      0           3       0             0           2       0
## 4        0      1           0       1             1           0       0
## 5        0      0           0       0             2           0       0
## 6        0      0           0       0             0           0       0
## 7        1      0           0       0             0           0       0
## 8        0      0           0       0             0           0       0
## 9        0      0           0       0             0           0       0
##   PeterHamilton sarahstood mcolacurcio marybethlambert
## 1             0          0           0               0
## 2             0          0           0               0
## 3             1          0           0               1
## 4             1          2           1               0
## 5             0          0           1               0
## 6             0          0           0               0
## 7             0          0           0               0
## 8             0          0           0               0
## 9             0          0           0               0

La cantidad de filas nos dice los tamaños de los cliques máximales, es decir, un clique que no se puede ampliar incluyendo un nodo adyacente más (no es un subconjunto de un camarilla más grande):

  • Ningun clique de tamaño 1:
census$clique.count[1,1]
## [1] 0
  • 10 cliques de tamaño 2:
census$clique.count[2,1]
## [1] 10
  • 1 clique de tamaño 9:
census$clique.count[9,1]
## [1] 1
Figura 5. Cliques máximales y no maximales.
Fuente: math.stackexchange.com.


Si hay cliques, se sospecha la presencia de comunidades.

Detección de comunidades

  1. Estrategia Divisiva (Top-Down): Veamos cómo se cálcula comunidades basadas en la intermediación, es decir comunidades que aparecen al remover los enlaces con alta intermediación:
sort(edge_betweenness(topsNet_giant,directed = T),decreasing = T)[1:5]
## [1] 42.12500 41.80284 26.52518 26.29048 23.73203
l=layout_with_fr(topsNet_giant)
plot(topsNet_giant,layout=l,edge.arrow.size=1,vertex.label='',
     edge.color=ifelse(edge_betweenness(topsNet_giant)>40,'red','grey90'))

El trabajo sería ir eliminando vertices hasta quedarse con la ‘mejor’ partición. Esto lo hace directamente el algoritmo the Girvan-Newman:

topsNet_giant_GN <- cluster_edge_betweenness(topsNet_giant, directed=T)
topsNet_giant_GN
## IGRAPH clustering edge betweenness, groups: 2, mod: 0.0032
## + groups:
##   $`1`
##    [1] "rachelerman"     "mattmcilwain"    "DaveParkerSEA"   "toddbishop"     
##    [5] "ashannstew"      "LeslieFeinzaig"  "matt_oppy"       "gilbert"        
##    [9] "juliesandler"    "BradSmi"         "crashdev"        "ShaunaCausey"   
##   [13] "john_gabbert"    "moniguzman"      "mattmday"        "Rich_Barton"    
##   [17] "daryn"           "lovelletters"    "etzioni"         "MissDestructo"  
##   [21] "heatherredman"   "danshapiro"      "medinism"        "KieranSnyder"   
##   [25] "hadip"           "RajSinghSeattle" "funcOfJoe"       "kirbywinfield"  
##   [29] "stevesi"         "Ryanintheus"     "sonalpmane"      "SoGulley"       
##   [33] "jinman"          "Jenerationy"     "lanctot"         "Kristen_Hammy"  
##   + ... omitted several groups/vertices

Se indica que ha encontrado sólo dos comunidades. Nótese que indica que este resultado es el que dió la ’mejor” partición: la mejor modularidad:

modularity(topsNet_giant_GN)
## [1] 0.003175803

El detalle de las dos comunidades lo vemos así:

communities(topsNet_giant_GN)
## $`1`
##  [1] "rachelerman"     "mattmcilwain"    "DaveParkerSEA"   "toddbishop"     
##  [5] "ashannstew"      "LeslieFeinzaig"  "matt_oppy"       "gilbert"        
##  [9] "juliesandler"    "BradSmi"         "crashdev"        "ShaunaCausey"   
## [13] "john_gabbert"    "moniguzman"      "mattmday"        "Rich_Barton"    
## [17] "daryn"           "lovelletters"    "etzioni"         "MissDestructo"  
## [21] "heatherredman"   "danshapiro"      "medinism"        "KieranSnyder"   
## [25] "hadip"           "RajSinghSeattle" "funcOfJoe"       "kirbywinfield"  
## [29] "stevesi"         "Ryanintheus"     "sonalpmane"      "SoGulley"       
## [33] "jinman"          "Jenerationy"     "lanctot"         "Kristen_Hammy"  
## [37] "nhuntwalker"     "PeterHamilton"   "sarahstood"      "mcolacurcio"    
## [41] "marybethlambert"
## 
## $`2`
## [1] "akipman" "JenMsft"

La pertenecia a cada grupo podemos guardarla como un atributo:

V(topsNet_giant)$GNpartition=topsNet_giant_GN$membership

Veamos el resultado de manera gráfica:

l=layout_with_kk(topsNet_giant)

plot(topsNet_giant_GN,topsNet_giant,rescale=T, layout=l,vertex.label='',edge.arrow.size=.2)

  1. Estrategia Aglomerativa (BottomUp): Veamos el uso del algoritmo Louvain, un algoritmo que va agrupando a los nodos en pequenos grupos, deteniendose cuando la modularidad no mejora:
topsNet_giant_LV=cluster_louvain(as.undirected(topsNet_giant,mode="mutual"))
topsNet_giant_LV
## IGRAPH clustering multi level, groups: 4, mod: 0.2
## + groups:
##   $`1`
##    [1] "rachelerman"     "ashannstew"      "akipman"         "matt_oppy"      
##    [5] "gilbert"         "BradSmi"         "crashdev"        "john_gabbert"   
##    [9] "mattmday"        "daryn"           "medinism"        "RajSinghSeattle"
##   
##   $`2`
##    [1] "mattmcilwain"   "DaveParkerSEA"  "LeslieFeinzaig" "juliesandler"  
##    [5] "lovelletters"   "etzioni"        "MissDestructo"  "heatherredman" 
##    [9] "funcOfJoe"      "kirbywinfield"  "sonalpmane"     "SoGulley"      
##   
##   + ... omitted several groups/vertices

Veamos la modularidad obtenida:

modularity(topsNet_giant_LV)
## [1] 0.1950164

Y las comunidades:

communities(topsNet_giant_LV)
## $`1`
##  [1] "rachelerman"     "ashannstew"      "akipman"         "matt_oppy"      
##  [5] "gilbert"         "BradSmi"         "crashdev"        "john_gabbert"   
##  [9] "mattmday"        "daryn"           "medinism"        "RajSinghSeattle"
## 
## $`2`
##  [1] "mattmcilwain"   "DaveParkerSEA"  "LeslieFeinzaig" "juliesandler"  
##  [5] "lovelletters"   "etzioni"        "MissDestructo"  "heatherredman" 
##  [9] "funcOfJoe"      "kirbywinfield"  "sonalpmane"     "SoGulley"      
## 
## $`3`
##  [1] "toddbishop"      "ShaunaCausey"    "moniguzman"      "Ryanintheus"    
##  [5] "jinman"          "Jenerationy"     "lanctot"         "PeterHamilton"  
##  [9] "sarahstood"      "mcolacurcio"     "marybethlambert"
## 
## $`4`
## [1] "Rich_Barton"   "danshapiro"    "KieranSnyder"  "hadip"        
## [5] "stevesi"       "Kristen_Hammy" "nhuntwalker"   "JenMsft"

La pertenecia a cada grupo podemos guardarla nuevamente como un atributo del nodo:

V(topsNet_giant)$LVpartition=topsNet_giant_LV$membership

Aqui de manera gráfica:

l=layout_with_kk(topsNet_giant)

plot(topsNet_giant_LV,topsNet_giant,layout=l,vertex.label='',edge.arrow.size=.2)



Revelando roles

Agujeros Estructurales

Un tema clave es encontrar, en medio de todos los nodos, aquellos cuya posición y patrón de conexiones nos revele que tienen mejores condiciones para facilitar o restringir el flujo que se traslada por la red. Nótese en la Figura 7 la presencia de agujeros, y la emergencia de nodos que median el flujo entre subredes.

Figura 7. Agujeros Estructurales.
Fuente: Kleinberg, Suri, Tardos & Wexler (n.d.). Strategic Network Formation With Structural Holes.



Por ejemplo, podemos calcular los tres nodos más claves siguiendo esa idea:

#install.packages("influenceR", dependencies = TRUE)

influenceR::keyplayer(topsNet_giant,3)
## + 3/43 vertices, named, from 5b12f72:
## [1] mattmcilwain toddbishop   SoGulley

Alternativamente, podemos revelar quiénes tienen menos restricciones en la red para lo mismo:facilitar o restringir el flujo que se traslada por la red.

igraph::constraint(topsNet_giant)
##     rachelerman    mattmcilwain   DaveParkerSEA      toddbishop      ashannstew 
##       0.1159127       0.1433083       0.1145126       0.1013494       0.1394147 
##  LeslieFeinzaig         akipman       matt_oppy         gilbert    juliesandler 
##       0.1430804       0.2765752       0.1314037       0.1393513       0.1156528 
##         BradSmi        crashdev    ShaunaCausey    john_gabbert      moniguzman 
##       0.1502496       0.1227078       0.1123185       0.2234507       0.1195957 
##        mattmday     Rich_Barton           daryn    lovelletters         etzioni 
##       0.1487804       0.1371157       0.1775320       0.1258692       0.1381820 
##   MissDestructo   heatherredman      danshapiro        medinism    KieranSnyder 
##       0.1282831       0.1182542       0.1493675       0.1853486       0.1278971 
##           hadip RajSinghSeattle       funcOfJoe   kirbywinfield         stevesi 
##       0.1194759       0.1334484       0.1887772       0.1414997       0.1135172 
##     Ryanintheus      sonalpmane        SoGulley          jinman     Jenerationy 
##       0.1431305       0.1661130       0.1287263       0.2464649       0.1454532 
##         lanctot   Kristen_Hammy     nhuntwalker         JenMsft   PeterHamilton 
##       0.1622389       0.1506816       0.2307269       0.2212805       0.1784957 
##      sarahstood     mcolacurcio marybethlambert 
##       0.2040247       0.1691871       0.2861118

Así, sabiendo que hay agujeros estructurales, podemos animarnos a asignar roles de brokerage.

Brokerage

Pensemos en una red que tiene tres particiones A, B, y C, es decir, los nodos están en sólo una de ellas, podemos asignar los siguientes roles:

La librería igraph no calcula estos roles, pero si se puede con la librería statnet. Primero, se debe convertir la red de un formato a otro:

#install.packages("intergraph")
topsNet_giant_statnet <- intergraph::asNetwork(topsNet_giant)

Ahora, veamos los roles:

library(statnet)
brokerage(topsNet_giant_statnet,
          cl=get.vertex.attribute(topsNet_giant_statnet, "LVpartition"))$raw.nli
##                 w_I w_O b_IO b_OI b_O   t
## rachelerman      52  15   69  115  64 315
## mattmcilwain      9   3    7   23   5  47
## DaveParkerSEA    21  14  103   36  61 235
## toddbishop       42  78  220  132 254 726
## ashannstew        5   3    7   19  14  48
## LeslieFeinzaig    9   2   25   35  25  96
## akipman           0   0    0    1   0   1
## matt_oppy        13   4   52   13  15  97
## gilbert           2   1    9   13  18  43
## juliesandler     30  34  104   84  81 333
## BradSmi           7   3    9   21   7  47
## crashdev         11   6   33   49  49 148
## ShaunaCausey     45  20  118   92  84 359
## john_gabbert      0   0    1    1   0   2
## moniguzman       28   9   78   64  59 238
## mattmday         16   2   15   15   5  53
## Rich_Barton       2   0    2   13   5  22
## daryn             2   0   10    3   1  16
## lovelletters     18   6   53   57  66 200
## etzioni          10   7   24   24  19  84
## MissDestructo    15   5   49   29  35 133
## heatherredman    17  29   74   79  95 294
## danshapiro        1   0    4   10   2  17
## medinism          3   0    0    3   0   6
## KieranSnyder     11   8   28   31  20  98
## hadip             2   7   10   16  27  62
## RajSinghSeattle   5   5    6   21  11  48
## funcOfJoe         1   0    3    0   0   4
## kirbywinfield     7   4   14   22   9  56
## stevesi          19  17   52   65  75 228
## Ryanintheus       3   1   22   12  14  52
## sonalpmane        0   0   13    1   1  15
## SoGulley          1   2   24   10  14  51
## jinman            0   0    1    0   0   1
## Jenerationy       5   0   16    3   5  29
## lanctot           0   0    6    3   4  13
## Kristen_Hammy     1   3    6    8   6  24
## nhuntwalker       2   0    3    4   2  11
## JenMsft           1   0    4    2   2   9
## PeterHamilton     2   0    7    1   3  13
## sarahstood        2   0    6    0   0   8
## mcolacurcio       1   0    3    4   4  12
## marybethlambert   0   0    0    1   0   1

Un poco de traducción:

Es decir: rachelerman ocupa 35 veces rol de Coordinador, 15 rol de Consultor, 85 de Portero, 100 de Representante, y 80 liasion.


Recuerda que el brokerage se ha calculado con tres particiones, según Gephi, y que en R lo hicimos con cuatro particiones.

Ejercicio

Para este ejercicio trabaje con toda la red de los innovadores de Seattle (no sólo con el mayor componente).

  1. Importar el archivo topsNetFull.graphml en Gephi (está en su carpeta data); a esa red calcular las comunidades y exportar esos datos para UCINET.
  2. Importar en UCINET la matriz de adyacencia seattleTop_adjMx.csv (está en su carpeta data); a esa matriz convertirla en red de UCINET.
  3. Calcule los brokerage de esta red, y comente las diferencias más resaltantes que encuentra en relación a los roles brokerage antes calculados en UCINET para la red del mayor componente.

Prepara tu respuesta con texto e imagenes de lo obtenido en un GoogleDoc.